home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / GEMDEBUG.I < prev    next >
Encoding:
Modula Implementation  |  1991-08-21  |  11.6 KB  |  434 lines
  1. IMPLEMENTATION MODULE Debug; (* V#050, Stand: 21.8.91 *)
  2. (*$B+,R-,F-*)
  3.  
  4. (*
  5.  * Version für MOS 1.x erstellt Mai '87 von Thomas Tempelmann
  6.  * Version für MOS 2.x erstellt März '90 von Thomas Tempelmann
  7.  *)
  8.  
  9. (*
  10.  *   G E M - V e r s i o n
  11.  *  =======================
  12.  *
  13.  * Gibt Modula-Zeilen aus, die erzeugt werden, wenn im Quelltext die
  14.  * Compiler-Option "(*$D+*)" verwendet wird.
  15.  *
  16.  * Eine "Debug"-Ausgabeanweisung, die der Compiler erzeugt, hat folg. Format:
  17.  *
  18.  *   ... normaler Maschinencode ...
  19.  *   TRAP #5       -  Assembler-Anweisung, löst TRAP-5 Exception aus.
  20.  *   DC.W cmd      -  Kennung, die bestimmt, ob Zeile oder eine Zahl angezeigt
  21.  *                    werden soll (siehe unten, Funktion 'dispLine').
  22.  * [ ASC  '...' ]  -  Modula-Text, falls eine Zeile angezeigt werden soll;
  23.  *                    sonst steht die bestimmte Zahl auf dem Parameterstack.
  24.  *)
  25.  
  26. FROM SYSTEM IMPORT ADR, ADDRESS, BYTE, WORD, LONGWORD;
  27.  
  28. FROM Excepts IMPORT InstallPreExc;
  29.  
  30. FROM PrgCtrl IMPORT TermProcess, CatchProcessTerm, TermCarrier;
  31.  
  32. FROM Strings IMPORT Length, String, Empty;
  33.  
  34. FROM MOSGlobals IMPORT UserBreak, MemArea;
  35.  
  36. FROM SysTypes IMPORT ExcSet, TRAP5, ExcDesc;
  37.  
  38. FROM TextWindows IMPORT Read, CondRead, ReadString, ForceMode,
  39.         FlushKbd, WQualitySet, WindowQuality, Window, ShowMode;
  40.  
  41. IMPORT TextWindows;
  42.  
  43. FROM ModCtrl IMPORT GetModName;
  44.  
  45. FROM SysUtil1 IMPORT Peek;
  46.  
  47. IMPORT StrConv;
  48.  
  49. IMPORT SYSTEM, FPUSupport;
  50.  
  51. FROM GEMShare IMPORT error;
  52.  
  53.  
  54. TYPE Mode = (m2Line, asmLine, procEntry, procExit);
  55.  
  56. VAR WaitNext, WaitKey: BOOLEAN;
  57.  
  58.     io: Window;
  59.  
  60.  
  61. PROCEDURE WriteString (REF s:ARRAY OF CHAR);
  62.   BEGIN
  63.     TextWindows.WriteString (io,s)
  64.   END WriteString;
  65.  
  66. PROCEDURE Write (s: CHAR);
  67.   BEGIN
  68.     TextWindows.Write (io,s)
  69.   END Write;
  70.  
  71. PROCEDURE WriteLn;
  72.   BEGIN
  73.     TextWindows.WriteLn (io)
  74.   END WriteLn;
  75.  
  76. PROCEDURE WriteLHex (v:LONGWORD; n: CARDINAL);
  77.   BEGIN
  78.     WriteString (StrConv.LHexToStr (v, n))
  79.   END WriteLHex;
  80.  
  81. PROCEDURE dispRegs (VAR info: ExcDesc);
  82.   BEGIN
  83.     WriteLn;
  84.     WITH info DO
  85.       WriteString ('D0:');  WriteLHex (regD0,9);
  86.       WriteString (' D1:'); WriteLHex (regD1,9);
  87.       WriteString (' D2:'); WriteLHex (regD2,9);
  88.       WriteString (' D3:'); WriteLHex (regD3,9);
  89.       WriteLn;
  90.       WriteString ('D4:');  WriteLHex (regD4,9);
  91.       WriteString (' D5:'); WriteLHex (regD5,9);
  92.       WriteString (' D6:'); WriteLHex (regD6,9);
  93.       WriteString (' D7:'); WriteLHex (regD7,9);
  94.       WriteLn;
  95.       WriteString ('A0:');  WriteLHex (regA0,9);
  96.       WriteString (' A1:'); WriteLHex (regA1,9);
  97.       WriteString (' A2:'); WriteLHex (regA2,9);
  98.       WriteString (' A3:'); WriteLHex (regA3,9);
  99.       WriteLn;
  100.       WriteString ('A4:');  WriteLHex (regA4,9);
  101.       WriteString (' A5:'); WriteLHex (regA5,9);
  102.       WriteString (' A6:'); WriteLHex (regA6,9);
  103.       WriteString (' A7:'); WriteLHex (regUSP,9);
  104.     END
  105.   END dispRegs;
  106.  
  107.  
  108. PROCEDURE dispLine (mode: Mode; VAR info: ExcDesc);
  109.   
  110.   VAR buffered: BOOLEAN; bufCh: CHAR;
  111.   
  112.   PROCEDURE KeyPress():BOOLEAN;
  113.     BEGIN
  114.       CondRead (bufCh,buffered);
  115.       RETURN buffered
  116.     END KeyPress;
  117.   
  118.   PROCEDURE GetKey (VAR ch:CHAR);
  119.     BEGIN
  120.       IF buffered THEN
  121.         buffered:= FALSE;
  122.         ch:= bufCh
  123.       ELSE
  124.         TextWindows.BusyRead (ch)
  125.       END
  126.     END GetKey;
  127.   
  128.   VAR ch:CHAR; s:ARRAY [0..9] OF CHAR; p:CARDINAL; done,ok:BOOLEAN;
  129.       ps: POINTER TO ARRAY [0..160] OF CHAR;
  130.       proc,name: ARRAY [0..39] OF CHAR; rel: LONGCARD;
  131.   
  132.   BEGIN (* dispLine *)
  133.     IF WaitKey THEN
  134.       buffered:= FALSE;
  135.       IF ~Continuous OR KeyPress() THEN
  136.         IF Active THEN TextWindows.Show (io) END;
  137.         REPEAT
  138.           GetKey (ch);
  139.           IF TextWindows.WasClosed (io) THEN
  140.             TextWindows.Hide (io);
  141.             Active:= FALSE
  142.           END;
  143.           ok:= TRUE;
  144.           CASE CAP (ch) OF
  145.             15C: Continuous:= TRUE|                             (* RETURN *)
  146.             ' ': Continuous:= FALSE|                            (* SPACE *)
  147.             3C : TermProcess (UserBreak)|                       (* CTRL-C *)
  148.             'A': Step:= 0L; Active:= TRUE; Continuous:= FALSE|
  149.             'S': WriteString ('Step? '); ReadString (io,s); p:=0;
  150.                  Step:= StrConv.StrToLCard (s,p,done);
  151.                  IF done THEN
  152.                    Active:= FALSE; Continuous:= TRUE; TextWindows.Hide (io);
  153.                  END|
  154.             'L': LineAddr:= ~LineAddr; ok:= FALSE|
  155.             'H': Hex:= TRUE; ok:= FALSE|
  156.             'D': Hex:= FALSE; ok:= FALSE|
  157.             'R': dispRegs (info); ok:= FALSE|
  158.           ELSE
  159.             ok:= FALSE
  160.           END
  161.         UNTIL ok
  162.       END
  163.     END;
  164.     
  165.     IF WaitNext THEN FlushKbd; WaitKey:= TRUE; WaitNext:= FALSE END;
  166.     
  167.     IF Active THEN Step:= 0L END;
  168.     
  169.     IF Step # 0L THEN
  170.       DEC (Step);
  171.       IF Step = 0L THEN Active:= TRUE; Continuous:= FALSE END;
  172.     END;
  173.     
  174.     ps:= info.regPC;                    (* PC hinter Zeilentext setzen *)
  175.     INC (info.regPC,Length (ps^)+1);
  176.     IF ODD (info.regPC) THEN INC (info.regPC) END;
  177.     
  178.     IF Active THEN                      (* Zeile anzeigen *)
  179.       WriteLn;
  180.       IF (mode = m2Line) OR (mode = asmLine) THEN
  181.         IF LineAddr THEN
  182.           WriteLHex (info.regPC,9);
  183.           WriteString (': ');
  184.           GetModName (info.regPC,name,rel,proc);
  185.           WriteString (name);
  186.           WriteString (' / ');
  187.           IF ~Empty (proc) THEN
  188.             WriteString (proc)
  189.           ELSE
  190.             WriteLHex (rel,5)
  191.           END;
  192.           WriteLn;
  193.         END;
  194.         IF ps^[0]=12C (* LF *) THEN INC (ps) END;
  195.         WriteString (ps^);
  196.         WriteLn;
  197.       ELSE
  198.         IF mode = procEntry THEN
  199.           WriteString ('Enter ')
  200.         ELSE
  201.           WriteString ('                                   Exit ')
  202.         END;
  203.         WriteString (ps^);
  204.       END;
  205.     END;
  206.   END dispLine;
  207.  
  208.  
  209. MODULE RealSupport;
  210.  
  211.   FROM SYSTEM IMPORT LONGWORD, ASSEMBLER;
  212.   FROM FPUSupport IMPORT NewContext, SaveContext, RestoreContext, FPUContext;
  213.  
  214.   EXPORT SaveTempRealRegs, RestoreTempRealRegs;
  215.  
  216.   TYPE TempRealRegBuffer = ARRAY [1..6] OF LONGWORD;
  217.  
  218.   VAR buffer: TempRealRegBuffer;
  219.   VAR fpu: FPUContext;
  220.  
  221.   PROCEDURE SaveTempRealRegs ();
  222.     BEGIN
  223.       ASSEMBLER
  224.         ; die ersten 3 Pseudo-Regs aus dem Modul Runtime
  225.         LEA buffer,A1
  226.         LEA @FP0L,A0 MOVEQ #5,D0 l1 MOVE.L (A0)+,(A1)+ DBRA D0,l1
  227.       END;
  228.       SaveContext (fpu);
  229.     END SaveTempRealRegs;
  230.  
  231.   PROCEDURE RestoreTempRealRegs ();
  232.     BEGIN
  233.       ASSEMBLER
  234.         LEA buffer,A1
  235.         LEA @FP0L,A0 MOVEQ #5,D0 l1 MOVE.L (A1)+,(A0)+ DBRA D0,l1
  236.       END;
  237.       RestoreContext (fpu);
  238.     END RestoreTempRealRegs;
  239.  
  240.   BEGIN
  241.     NewContext (fpu)
  242.   END (* MODULE *) RealSupport;
  243.  
  244.  
  245. PROCEDURE HdlExc ( VAR info: ExcDesc ): BOOLEAN;
  246.  
  247.   PROCEDURE loadValue (VAR v: ARRAY OF BYTE);
  248.     (* holt Wert vom A3-Stack und korrigiert A3 dabei auch *)
  249.     VAR n: CARDINAL;
  250.     BEGIN
  251.       n:= HIGH (v);
  252.       IF n = 0 THEN INC (n) END;
  253.       DEC (info.regA3.p, n+1);
  254.       Peek (info.regA3.p, v);
  255.     END loadValue;
  256.  
  257.   PROCEDURE dispNum (size: CARDINAL; signed: BOOLEAN);
  258.     VAR by: BYTE; wd: WORD; lw: LONGWORD;
  259.     BEGIN
  260.       IF size = 4 THEN
  261.         loadValue (lw);
  262.       ELSE
  263.         IF size = 2 THEN
  264.           loadValue (wd);
  265.         ELSE
  266.           loadValue (by);
  267.           IF signed THEN
  268.             wd:= WORD (INT (by))
  269.           ELSE
  270.             wd:= WORD (ORD (by))
  271.           END
  272.         END;
  273.         IF signed THEN
  274.           lw:= LONGWORD (LONG (INTEGER (wd)))
  275.         ELSE
  276.           lw:= LONGWORD (LONG (CARDINAL (wd)))
  277.         END
  278.       END;
  279.       IF Active THEN
  280.         IF Hex THEN
  281.           WriteLHex (lw,0);
  282.         ELSIF signed THEN
  283.           WriteString (StrConv.IntToStr (LONGINT (lw),0));
  284.         ELSE
  285.           WriteString (StrConv.CardToStr (LONGCARD (lw),0));
  286.         END
  287.       END;
  288.     END dispNum;
  289.  
  290.   PROCEDURE dispChar ();
  291.     VAR ch: CHAR;
  292.     BEGIN
  293.       loadValue (ch);
  294.       IF Active THEN
  295.         IF ch < ' ' THEN       (* Steuerzeichen als Oktalkonstante anzeigen *)
  296.           WriteString (StrConv.NumToStr (ORD (ch),8,0,' '));
  297.           Write ('C')
  298.         ELSE
  299.           Write ("'");
  300.           Write (ch);
  301.           Write ("'");
  302.         END
  303.       END;
  304.     END dispChar;
  305.  
  306.   PROCEDURE dispReal (long: BOOLEAN);
  307.     VAR sr: REAL; lr: LONGREAL;
  308.     BEGIN
  309.       IF long THEN
  310.         loadValue (lr)
  311.       ELSE
  312.         loadValue (sr);
  313.         lr:= LONG (sr)
  314.       END;
  315.       IF Active THEN
  316.         (* retten der temp. Real-Regs, da dies
  317.          * nicht vom Excepts-Modul erledigt wird: *)
  318.         SaveTempRealRegs;
  319.         WriteString (StrConv.RealToStr (lr,0,6));
  320.         RestoreTempRealRegs;
  321.       END;
  322.     END dispReal;
  323.  
  324.   PROCEDURE dispBool ();
  325.     VAR b: BOOLEAN;
  326.     BEGIN
  327.       loadValue (b);
  328.       IF Active THEN
  329.         IF b THEN
  330.           WriteString ('TRUE ')
  331.         ELSE
  332.           WriteString ('FALSE')
  333.         END
  334.       END;
  335.     END dispBool;
  336.  
  337.   PROCEDURE dispString ();
  338.     (* Für Strings werden Adresse und HIGH-Wert auf dem A3-Stack abgelegt *)
  339.     VAR high: CARDINAL; ptr: POINTER TO CHAR;
  340.     BEGIN
  341.       loadValue (high);
  342.       loadValue (ptr);
  343.       IF Active THEN
  344.         Write ('"');
  345.         LOOP
  346.           IF ptr^ = 0C THEN EXIT END;
  347.           Write (ptr^);
  348.           INC (ptr);
  349.           IF high = 0 THEN EXIT END;
  350.           DEC (high)
  351.         END;
  352.         Write ('"')
  353.       END;
  354.     END dispString;
  355.  
  356.   VAR no:CARDINAL; gemError, old: BOOLEAN;
  357.  
  358.   BEGIN
  359.     gemError:= (*GEMShare.*)error; (*GEMShare.*)error:= FALSE;
  360.     no:= CARDINAL (info.regPC^);
  361.     INC (info.regPC,2);
  362.     CASE no OF
  363.       0 : dispLine (m2Line, info)|
  364.       64: dispLine (asmLine, info)|
  365.       66: dispLine (procEntry, info)|
  366.       67: dispLine (procExit, info)|
  367.     ELSE
  368.       CASE no OF
  369.             1,4: dispNum (4, TRUE)|
  370.               2: dispReal (TRUE)|
  371.              40: dispReal (FALSE)|
  372.               3: dispChar ()|
  373.         35,34,9: dispNum (2, FALSE)|
  374.   8,20,23,25,26: old:= Hex; Hex:= TRUE; dispNum (4, FALSE); Hex:= old|
  375.           21,41: old:= Hex; Hex:= TRUE; dispNum (2, FALSE); Hex:= old|
  376.           30,22: dispNum (4, FALSE)|
  377.              24: dispBool ()|
  378.              27: dispString ()|
  379.              33: dispNum (2, TRUE)|
  380.           38,39: old:= Hex; Hex:= TRUE; dispNum (1, FALSE); Hex:= old|
  381.       ELSE
  382.           (* Tja - da haben wir einen Code nicht ausgewertet! *)
  383.           WriteLn;
  384.           WriteLn;
  385.           WriteString ('*** Fehler in Debug-Modul - unbekannter Code:');
  386.           WriteLn;
  387.           WriteString (StrConv.CardToStr (no,0));
  388.           HALT
  389.       END;
  390.       IF Active THEN
  391.         WriteString ('   ')
  392.       END
  393.     END;
  394.     (*GEMShare.*)error:= gemError;
  395.     RETURN FALSE
  396.   END HdlExc;
  397.  
  398.  
  399. VAR stk: ARRAY [1..2000] OF CARDINAL;
  400.     wsp: MemArea;
  401.     hdl: ADDRESS;
  402.     tHdl: TermCarrier;
  403.     ok: BOOLEAN;
  404.  
  405. PROCEDURE Terminate;
  406.   VAR ch:CHAR;
  407.   BEGIN
  408.     TextWindows.Show (io);
  409.     WriteLn;
  410.     WriteString ('Programmende: Bitte Taste...');
  411.     Read (io,ch)
  412.   END Terminate;
  413.  
  414. BEGIN
  415.   Active:= TRUE;
  416.   Step:= 0L;
  417.   Continuous:= FALSE;
  418.   Hex := FALSE;
  419.   LineAddr:= FALSE;
  420.   
  421.   (* damit erste Zeile sofort erscheint: *)
  422.   WaitKey:= FALSE;
  423.   WaitNext:= TRUE;
  424.   
  425.   TextWindows.Open (io, 70,100, WQualitySet{movable,closable,dynamic,titled},
  426.                     hideWdw, forceLine, ' Debugger ', -1,-1,-1,-1, ok);
  427.   
  428.   wsp.bottom:= ADR (stk);
  429.   wsp.length:= SIZE (stk);
  430.   InstallPreExc (ExcSet{TRAP5}, HdlExc, TRUE, wsp, hdl);
  431.   IF hdl=NIL THEN HALT END;
  432.   CatchProcessTerm (tHdl,Terminate,wsp);
  433. END Debug.
  434.